;; The first four lines of this file were added by Dracula.
;; They tell DrScheme that this is a Dracula Modular ACL2 program.
;; Leave these lines unchanged so that DrScheme can properly load this file.
#reader(planet "reader.rkt" ("cce" "dracula.plt") "modular" "lang")
(in-package "ACL2")

(require "Iio.lisp")
(require "mbmptree.lisp")
(require "mavltree.lisp")
(require "mhelpers.lisp")
(require "mgreyscale.lisp")
(require "mhuechange.lisp")
(require "mphotonegative.lisp")
(require "mrotate.lisp")
(require "mcolorshift.lisp")
(require "mmirroring.lisp")
(require "mhipstafy.lisp")
(require "mresize.lisp")
(require "mcrop.lisp")
(require "mborder.lisp")

(module Mio
  (import Ibmptree)
  (import Iavltree)
  (import iHelpers)
  (import iGreyscale)
  (import iHueChange)
  (import iPhotonegative)
  (import iRotate)
  (import iColorShift)
  (import iHipstafy)
  (import Icrop)
  (import Iresize)
  (import iMirroring)
  (import IBorder)
  (include-book "io-utilities" :dir :teachpacks)
  (include-book "list-utilities" :dir :teachpacks)
  (include-book "binary-io-utilities" :dir :teachpacks)
  (set-state-ok t)
  
  
  ; gets the element that occurs at the x position in the list xs
  (defun get-datum (xs x)
    (if (not (equal x 1))
        (get-datum (cdr xs) (- x 1))
        (car xs)))
  
  ; gets the elements from begin to end in the list datalist
  (defun get-values (datalist begin end)
    (if (<= end begin)
        (list (car datalist))
        (append (list (car datalist)) (get-values (cdr datalist) (+ begin 1) end))))
  
  ; returns the rest of the elements in a list after the nth element
  (defun get-the-rest (list n)
    (if (equal n 1)
        (cdr list)
        (get-the-rest (cdr list) (- n 1))))
  
  ; creates the RGB list using red green blue elements
  (defun make-RGB (r g b)
    (list r g b))
  
  ;creates a list of pixels with each pixel having the format (row column (r g b))
  ;with the row being the position vertically  and the column being the position 
  ;horizontally
  (defun pixel-list (byte-list bit-size width x)
    (let* ((b (car byte-list))
           (g (cadr byte-list))
           (r (caddr byte-list))
           (rgb (make-RGB r g b))
           (column (mod x width))
           (row (floor x width))
           (pixel (list row column rgb)))
      (if (consp byte-list)
          (cons pixel (pixel-list (get-the-rest byte-list 3) bit-size width (+ x 1)))
          nil)))
  
  ; takes the list of pixels from pixel-list function and adds on the header list for the 
  ; complete tree input that includes (header p1 p2 ... pN)
  (defun list-for-tree (bmplist)
    (let* ((headersize (get-datum bmplist 11))
           (header (get-values bmplist 0 53))
           (pixels (pixel-list (get-the-rest bmplist 54)
                               (get-datum bmplist 29)(get-datum bmplist 19) 0)))
      (cons header pixels)))
  
  
  ; uses the list-for-tree function alongside the make-bmp-tree function from mbmptree
  ; in order to input the pixels into the tree for storage and quicker access
  (defun make-tree (f-in)
    (make-bmp-tree (list-for-tree (car (binary-file->byte-list f-in state)))))
  
  ; generates the specified amount of null bytes in a list form
  (defun make-padding (x)
    (if (> x 0)
        (cons 0 (make-padding (- x 1)))
        nil))
  
  ; returns the list of pixel data for a given tree that will be 
  ; written in the file after the header data
  (defun pixel-list-from-tree (tree x y width height count)
    (if (> y height)
        nil
        (let* ((rgb (get-pixel-color tree y x))
               (r (car rgb))
               (g (cadr rgb))
               (b (caddr rgb))
               (nextX (if (equal x width)
                          0
                          (+ x 1)))
               (nextY (if (equal x width)
                          (+ y 1)
                          y)))
          (if (equal (mod count (+ 1 width)) 0)
              (append (list b g r) (make-padding (mod (+ 1 width) 4)) (pixel-list-from-tree tree nextX nextY width height (+ count 1)))
              (append (list b g r) (pixel-list-from-tree tree nextX nextY width height (+ count 1)))))))
  
  ; returns the list of all the bytes to write to a file for the given tree
  (defun full-list (tree)
    (let* ((header (get-header tree))
           (width (cdr (get-dimensions tree)))
           (height (car (get-dimensions tree))))
      (append header (pixel-list-from-tree tree 0 0 (- width 1) (- height 1) 1))))
  
  ; writes out the tree to the specified bitmap file
  (defun tree->binary-file (tree f-out)
    (byte-list->binary-file f-out (full-list tree) state))
  
  ;takes in the query file that includes the commands for the file to create as well as 
  ; for the commands of what to do to each .bmp file and parses it into a list
  (defun read-queries-file (f-in)
    (let* ((file (car (file->string f-in state)))
           (filechrs (remove '#\return (str->chrs file)))
           (filelist (packets #\newline filechrs)))
      (read-queries-file filelist)))
  
  (defun get-bmp-file-to-tree (firstline)
    (let* ((make (chrs->str (car firstline)))
           (img (chrs->str (cadr firstline)))
           (newimg (chrs->str (caddr firstline)))
           (tree (make-tree img)))
      tree))
  
  ; execute-query reads the first element of each line to determine what function
  ; to call 
  (defun execute-query (list tree)
    (let* ((first (car list))
           (line (packets #\space first))
           (make (chrs->str (car line))))
      (if (consp list)
          (cond 
            ((equal make "blank") 
             (execute-query (cdr list) 
                            (make-solid-color-image (str->rat (chrs->str(second line)))    ;height
                                                    (str->rat (chrs->str(third line)))     ;width
                                                    (str->rat (chrs->str(fourth line)))    ;r
                                                    (str->rat (chrs->str(fifth line)))     ;g
                                                    (str->rat (chrs->str(sixth line))))))  ;b
            
            ((equal make "border") 
             (execute-query (cdr list) (border tree 
                                               (str->rat (chrs->str (second line)))    ;thickness
                                               (str->rat (chrs->str (third line)))     ;r
                                               (str->rat (chrs->str (fourth line)))    ;g
                                               (str->rat (chrs->str (fifth line))))))  ;b
            ((equal make "open") (execute-query (cdr list) (make-tree (chrs->str (cadr line)))))
            ((equal make "crop") (execute-query (cdr list)
                                                (crop tree (str->rat(chrs->str (cadr line)))
                                                      (str->rat(chrs->str (caddr line)))
                                                      (str->rat(chrs->str (cadddr line)))
                                                      (str->rat(chrs->str (fifth line))))))
            ((equal make "resize") (execute-query (cdr list)(resize tree (str->rat (chrs->str (cadr line))))))
            ((equal make "hipstafy") (execute-query (cdr list) (hipstafy tree)))
            ((equal make "mirror") (execute-query (cdr list) (mirror tree (chrs->str (cadr line)))))
            ((equal make "colorshift")
             (execute-query (cdr list) 
                            (color-shift tree
                                         (str->rat(chrs->str (cadr line)))
                                         (str->rat (chrs->str (third line)))
                                         (str->rat (chrs->str (fourth line)))
                                         (str->rat (chrs->str (fifth line)))
                                         (str->rat (chrs->str (sixth line)))
                                         (str->rat (chrs->str (seventh line))))))
            ((equal make "hue") 
             (execute-query (cdr list) (hue-change tree (str->rat(chrs->str (cadr line))))))
            ((equal make "greyscale") (execute-query (cdr list) (greyscale tree)))
            ((equal make "rotate") 
             (execute-query (cdr list) (rotate tree (str->rat (chrs->str (cadr line))))))
            ((equal make "photonegative") (execute-query (cdr list) (photonegative tree)))
            ((equal make "end")(and (tree->binary-file tree (chrs->str (cadr line)))
                                    (execute-query (cdr list) (empty-tree)))))
          nil)))
  
  
  (defun read-queries-and-execute (f-in)
    (let* ((file (car (file->string f-in state)))
           (filechrs (remove #\return (str->chrs file)))
           (filelist (packets #\newline filechrs)))
      (execute-query filelist (empty-tree))))
  
  (defun main (f-in)
    (read-queries-and-execute f-in))
  
  (export Iio))